home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Mode Examples / FORTRAN-Example.f < prev    next >
Encoding:
Text File  |  2000-10-30  |  16.0 KB  |  529 lines
  1.  
  2. c FORTRAN Example.f
  3. c 
  4. c Included in the Alpha distribution as an example of the Fort mode
  5. c 
  6. c source of original document:
  7. c 
  8. c http://www.fortran.com/
  9. c 
  10.  
  11.        PROGRAM COLORIT
  12.  
  13. c    *****************************************
  14. c    By Dale Bickel, Senior Electronics Engineer, dbickel@fcc.gov
  15. c    Audio Services Div., FCC (USA)
  16. c    http://www.fcc.gov/mmb/asd/
  17. c    
  18. c    This Fortran CGI application may be copied and/or 
  19. c    modified freely.  No restrictions are placed on its use. 
  20. c    ******************************************
  21. c    This program was created to develop a Fortran CGI.  It 
  22. c    receives input from HTML and generates HTML output.
  23. c    It could easily be modified to allow input from the 
  24. c    keyboard or a Fortran routine.
  25.  
  26. c    CGI access is required if the program is used as written. 
  27. c    The programming has not been optimized.  
  28. c    ****************************************** 
  29.  
  30. c    This Fortran 77 program prints the HTML color corresponding 
  31. c    to a six-place hexadecimal number.  It also prints, in table form,
  32. c    the colors which result by increasing or decreasing a single
  33. c    digit from the entered number.
  34. c    *******************************************
  35.  
  36. c    First, we read the six digit value sent over from the HTML.
  37. c    Because this program uses the GET method, this program
  38. c    reads the environment variable QUERY_STRING.   We 
  39. c    read each character from the string, and ignore unnecessary
  40. c    characters (here, ... ?input=  ).
  41. c    ********************************************
  42.  
  43. c    QS represents the character string  QUERY_STRING
  44. c    Digit is the numerical value of the corresponding character
  45. c    12 places are required to cover the whole QUERY_STRING
  46. c    input=AAAAAA
  47. c    ********************************************
  48.  
  49. c    Fortran reminders:
  50. c    Column 1 -- enter C for Comments
  51. c    Column 2-5 -- statement labels
  52. c    Column 6 -- continuation character
  53. c    Column 7 -- start commands in this column
  54. c    Column 72 -- Last column of statement -- use continuation
  55. c        characters or another Format statement if command is longer
  56.  
  57. c    First Statement of Program :  **********************             
  58.  
  59.        Character*12 QS
  60.        Character*1 newcolor
  61.        Dimension digit(12) 
  62.  
  63. c    ********************************************
  64.  
  65. c    Retrieve environment variable QUERY_STRING, using
  66. c    "getenv" get environment variable subroutine on system.
  67. c    This command may differ on other computer systems.
  68. c    QUERY_STRING will be stored in the character string QS.
  69.  
  70.        call getenv('QUERY_STRING', QS)
  71.     
  72. c    ******************************************
  73. c    Now we set up the Fortran code to generate HTML output.
  74. c    The Content-type: text/html // statement accomplishes
  75. c    this action.  The slashes // are VERY IMPORTANT!! 
  76. c    Watch the placement of the quotes!
  77.  
  78.        Write(6,55)
  79.  55    Format("Content-Type: text/html"//)
  80.  
  81. c    ******************************************
  82. c    From now on, the usual HTML tags will appear inside
  83. c    FORMAT statements.  Watch the quotation marks!
  84. c    Note that HTML tags may be placed on the same line, or 
  85. c    one tag may be broken up onto different lines.
  86.  
  87.        Write(6,64)
  88.        Write(6,65)
  89.        Write(6,66)
  90.  
  91.  64    Format('<HTML><HEAD><Title>')
  92.  65    Format('COLORIT Color Generator --- A Fortran CGI</Title>')
  93.  66    Format('</Head><Body bgcolor=' '#FFFFFF' '>')
  94.  
  95. c    Note the placement of the quote marks for the HTML 
  96. c    code bgcolor="#FFFFFF"> in the previous statement
  97. c    ******************************************
  98.  
  99. c    Here we generate the HTML for the output document's
  100. c    heading:
  101.  
  102.        Write(6,1400)
  103.        Write(6,1401)
  104.        Write(6,1402)
  105.        Write(6,1403)
  106.        Write(6,1404)
  107.        Write(6,1405)
  108.        Write(6,1406)     
  109.        Write(6,1407)
  110.        Write(6,1408)
  111.        Write(6,1410)
  112.        Write(6,1411)
  113.        Write(6,1412)
  114.        Write(6,1413)
  115.        Write(6,1414)
  116.        Write(6,1415)
  117.        Write(6,1416)
  118.        Write(6,1417)
  119.        Write(6,1418)
  120.  
  121.  1400  FORMAT('<Center>')      
  122.  1401  FORMAT('<A HREF=' 'http://www.fcc.gov/' '><IMG SRC=' )
  123.  1402  FORMAT('http://www.fcc.gov/fcc-gifs/hpban1.gif ' 'ALT=' )
  124.  1403  FORMAT(' [ Federal Communications Commission ] ' '></A>')
  125.  1404  FORMAT('<BR><a href=' )
  126.  1405  FORMAT('http://www.fcc.gov/fcc-bin/htimage/pub/www/pub/opa.map')
  127.  1406  FORMAT('><img src=' 'http://www.fcc.gov/fcc-gifs/iconbar.gif' )
  128.  1407  FORMAT('height=20' 'width=525' 'alt=' '[icon bar]' 'vspace=5' )
  129.  1408  FORMAT('border=1' 'ismap></a></CENTER><P>' )
  130.  1410  FORMAT('<Center><TABLE Border=0 ><TR ALIGN=LEFT>')
  131.  1411  FORMAT('<TD align=' 'left' '><IMG SRC=' )
  132.  1412  FORMAT('http://www.fcc.gov/fcc-gifs/sealtiny.gif')
  133.  1413  FORMAT(' alt=' '[ FCC Seal ]' '></TD><TD><B><H2>')
  134.  1414  FORMAT('<Font Color="#D81654">COLORIT Color ')
  135.  1415  FORMAT(' Generator</Font> ------ <Font Size=2><A HREF=')
  136.  1416  FORMAT('http://www.fcc.gov/mmb/asd/bickel/fortran.html')
  137.  1417  FORMAT('>A  Fortran CGI</A></Font></H2> Page 2')
  138.  1418  FORMAT(' -- Output</TD></TR></TABLE></Center><P>')
  139.  
  140. c    ************************************************* 
  141. c    Write the pertinent part of the Input QUERY_STRING to output 
  142.  
  143.        Write(6,79)
  144.  79    Format('<Center><H3><Font Color=' '#FF0000' '>Input Color: ')
  145.        Write(6,81) QS(7:7),QS(8:8),QS(9:9),QS(10:10),QS(11:11),QS(12:12)
  146.  81    Format('</Font><B> '      AAAAAA '</B></H3>')
  147.        Write(6,83)
  148.  83    Format('</Center><P>' )
  149.  
  150. c    ********************************************
  151. c    Here we replicate the initial HTML Form data entry fields
  152.  
  153.        Write(6,87)
  154.        Write(6,88)
  155.        Write(6,89)
  156.        Write(6,90)
  157.  
  158.        Write(6,96)
  159.        Write(6,92)
  160.        Write(6,93)
  161.        Write(6,94)
  162.        Write(6,95)
  163.        Write(6,96)
  164.  
  165.  
  166.  87    Format('<Center><Form method=' 'GET' ' action=')
  167.  88    Format('http://www.fcc.gov/fcc-bin/colorit' '>')
  168.  89    Format('Change Color Here:   ')
  169.  90    Format("<Input type='text' name='input' maxlength='6'>")
  170.  92    Format("<Input Type='submit'  value='Get New Color' >")
  171.  93    Format('<Font Color=' '#FFFFFE' '> . . .</Font>')
  172.  94    Format("<Input Type='reset'  value='Clear Form' >")
  173.  95    Format('</Form></Center>')
  174.  96    Format('<BR><BR>')
  175.  
  176. c    ***********************************************
  177. c    Be aware that "numbers" in the query_string really
  178. c    aren't numbers -- they're ASCII characters.  They must 
  179. c    be converted to integer or real numbers before use, 
  180. c    e.g., if(QS(*:*).eq."1") x=1
  181. c    
  182. c    Character entries in the query string can be retrieved
  183. c    by QS(first char. of substring : last char of substring)
  184. c    Both first and last characters will be retrieved.  
  185. c    
  186. c    In the following code, a numerical character is looked for and
  187. c    converted into its decimal counterpart.
  188.  
  189.        Do i=7,12,1
  190.  
  191.        If(QS(i:i).eq."0")  then
  192.        digit(i)=0.0
  193.        Else if(QS(i:i).eq."1")  then
  194.        digit(i)=1
  195.        Else if(QS(i:i).eq."2")  then
  196.        digit(i)=2
  197.        Else if(QS(i:i).eq."3")  then
  198.        digit(i)=3
  199.        Else if(QS(i:i).eq."4")  then
  200.        digit(i)=4
  201.        Else if(QS(i:i).eq."5")  then
  202.        digit(i)=5
  203.        Else if(QS(i:i).eq."6")  then
  204.        digit(i)=6
  205.        Else if(QS(i:i).eq."7")  then
  206.        digit(i)=7
  207.        Else if(QS(i:i).eq."8")  then
  208.        digit(i)=8
  209.        Else if(QS(i:i).eq."9")  then
  210.        digit(i)=9
  211.        Else if((QS(i:i).eq."A").or.(QS(i:i).eq."a")) then
  212.        digit(i)=10
  213.        Else if((QS(i:i).eq."B").or.(QS(i:i).eq."b"))  then
  214.        digit(i)=11
  215.        Else if((QS(i:i).eq."C").or.(QS(i:i).eq."c"))  then
  216.        digit(i)=12
  217.        Else if((QS(i:i).eq."D").or.(QS(i:i).eq."d"))  then
  218.        digit(i)=13
  219.        Else if((QS(i:i).eq."E").or.(QS(i:i).eq."e"))   then
  220.        digit(i)=14
  221.        Else if((QS(i:i).eq."F").or.(QS(i:i).eq."f"))   then
  222.        digit(i)=15
  223.        Else if(QS(i:i).eq."") then
  224.        Go to 162
  225.        Else 
  226.        Write(6,159) QS(i:i)
  227.  159   Format(A ' is not a valid character -- ')
  228.        Write(6,160)
  229.  160   Format('Please reenter six characters,<P>')
  230.        Write(6,161) 
  231.  161   Format('of type 0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F<P>') 
  232.           Go to 335
  233.  162   End if
  234.  
  235.        End do
  236.  
  237.        Write(6,167)
  238.        Write(6,168)
  239.        Write(6,169)
  240.  167   Format('<P>')
  241.  168   Format('<Center>')
  242.  169   Format('<Table width=' '95%' 'border=1>')
  243.  
  244. c    Loop through 9 rows, 4 above & 4 below the entered color code
  245.  
  246.  
  247.        Do j=-4,4,1
  248.        Write(6,177)
  249.  177   Format('<TR align=' 'center' '>')
  250.  
  251.        If(j.eq.0) then
  252.        Write(6,181)QS(7:7),QS(8:8),QS(9:9),QS(10:10),QS(11:11),QS(12:12)
  253.  181   Format('<TD colspan=6 bgcolor=' '#'AAAAAA)
  254.        Write(6,183)
  255.  183   Format('align=' 'center' '>.<BR>')
  256.  
  257. c    Create a small label table, inside the data element
  258.  
  259.        Write(6,189)
  260.        Write(6,190) QS(7:7),QS(8:8),QS(9:9),QS(10:10),QS(11:11),QS(12:12)
  261.  
  262.  189   Format('<Table border=0><TR><TD bgcolor=' '#FFFFFF' '>')
  263.  190   Format('Submitted color= 'AAAAAA' </TD></TR></Table>')
  264.  
  265.        Write(6,193)
  266.  193   Format('<BR>*</TD></TR>')
  267.        Go to 320
  268.          else if(j.ne.0) then       
  269.  
  270. c    Create HTML across the row -- 6 data elements
  271.  
  272.        Write(6,200)
  273.  200   Format('<TR align=' 'center' '>')
  274.  
  275.        Do i=7,12,1
  276.  
  277.        Number=digit(i)+j
  278.  
  279.         If(number.eq.0) then
  280.        newcolor="0"
  281.         Else if(number.eq.1) then
  282.        newcolor="1"
  283.         Else if(number.eq.2) then
  284.        newcolor="2"
  285.         Else if(number.eq.3) then
  286.        newcolor="3"
  287.         Else if(number.eq.4) then
  288.        newcolor="4"
  289.         Else if(number.eq.5) then
  290.        newcolor="5"
  291.         Else if(number.eq.6) then
  292.        newcolor="6"
  293.         Else if(number.eq.7) then
  294.        newcolor="7"
  295.         Else if(number.eq.8) then
  296.        newcolor="8"
  297.         Else if(number.eq.9) then
  298.        newcolor="9"
  299.         Else if(number.eq.10) then
  300.        newcolor="A"
  301.         Else if(number.eq.11) then
  302.        newcolor="B"
  303.         Else if(number.eq.12) then
  304.        newcolor="C"
  305.         Else if(number.eq.13) then
  306.        newcolor="D"
  307.         Else if(number.eq.14) then
  308.        newcolor="E"
  309.         Else if(number.eq.15) then
  310.        newcolor="F"
  311.         End if
  312.  
  313.        If((number.lt.0).or.(number.gt.15)) then
  314.        Write(6,243)
  315.  243      Format('<TD bgcolor=')
  316.           Write(6,244)
  317.  244      Format('#FFFFFF' '>No color</TD>')
  318.        Go to 320
  319.        End if
  320.  
  321.        Write(6,243)
  322.  
  323.        If(i.eq.7) then
  324.        write(6,270)newcolor,QS(8:8),QS(9:9),QS(10:10),QS(11:11),QS(12:12)
  325.  
  326.        Else if(i.eq.8) then
  327.        Write(6,270)QS(7:7),newcolor,QS(9:9),QS(10:10),QS(11:11),QS(12:12)
  328.  
  329.        Else if(i.eq.9) then
  330.        Write(6,270)QS(7:7),QS(8:8),newcolor,QS(10:10),QS(11:11),QS(12:12)
  331.  
  332.        Else if(i.eq.10) then
  333.        Write(6,270)QS(7:7),QS(8:8),QS(9:9),newcolor,QS(11:11),QS(12:12)
  334.  
  335.        Else if(i.eq.11) then
  336.        Write(6,270)QS(7:7),QS(8:8),QS(9:9),QS(10:10),newcolor,QS(12:12)
  337.  
  338.        Else if(i.eq.12) then
  339.        Write(6,270)QS(7:7),QS(8:8),QS(9:9),QS(10:10),QS(12:12),newcolor
  340.  
  341.        End if
  342.  270   Format(AAAAAA' align=' 'center' '><BR>')
  343.  
  344.  
  345. c    Create a label table inside the data element
  346.  
  347.        Write(6,276)
  348.  276   Format('<Table border=0><TR align=' 'center' '>')
  349.  
  350.        If(i.eq.7) then
  351.        Write(6,311)
  352.        Write(6,312)newcolor,QS(8:8),QS(9:9),QS(10:10),QS(11:11),QS(12:12)
  353.        Write(6,313)newcolor,QS(8:8),QS(9:9),QS(10:10),QS(11:11),QS(12:12)
  354.  
  355.        Else if(i.eq.8) then
  356.        Write(6,311)
  357.        Write(6,312)QS(7:7),newcolor,QS(9:9),QS(10:10),QS(11:11),QS(12:12)
  358.        Write(6,313)QS(7:7),newcolor,QS(9:9),QS(10:10),QS(11:11),QS(12:12)
  359.  
  360.        Else if(i.eq.9) then
  361.        Write(6,311)
  362.        Write(6,312)QS(7:7),QS(8:8),newcolor,QS(10:10),QS(11:11),QS(12:12)
  363.        Write(6,313)QS(7:7),QS(8:8),newcolor,QS(10:10),QS(11:11),QS(12:12)
  364.  
  365.        Else if(i.eq.10) then
  366.        Write(6,311)
  367.        Write(6,312)QS(7:7),QS(8:8),QS(9:9),newcolor,QS(11:11),QS(12:12)
  368.        Write(6,313)QS(7:7),QS(8:8),QS(9:9),newcolor,QS(11:11),QS(12:12)
  369.  
  370.        Else if(i.eq.11) then
  371.        Write(6,311)
  372.        Write(6,312)QS(7:7),QS(8:8),QS(9:9),QS(10:10),newcolor,QS(12:12)
  373.        Write(6,313)QS(7:7),QS(8:8),QS(9:9),QS(10:10),newcolor,QS(12:12)
  374.  
  375.        Else if(i.eq.12) then
  376.        Write(6,311)
  377.        Write(6,312)QS(7:7),QS(8:8),QS(9:9),QS(10:10),QS(11:11),newcolor
  378.        Write(6,313)QS(7:7),QS(8:8),QS(9:9),QS(10:10),QS(11:11),newcolor
  379.  
  380.        End if
  381.  
  382.        Write(6,314)
  383.  
  384.  311   Format('<TD bgcolor=' '#FFFFFF' '><A HREF=')
  385.  312   Format('http://www.fcc.gov/fcc-bin/colorit?input='AAAAAA'>')
  386.  313   Format(AAAAAA'</A></TD>')
  387.  314   Format('</TR></Table>')
  388.  
  389.        Write(6,318)
  390.  318   Format('<BR>.</TD>')
  391.  
  392.  320   Continue
  393.        End do
  394.  
  395.        Write(6,324)
  396.  324   Format('</TR>')
  397.  
  398.  99    Continue
  399.        End do
  400.  
  401.        End if
  402.        Write(6,330)
  403.  330   Format('</table></center>')
  404.  
  405.        Write(6,331)
  406.        Write(6,332)
  407.        Write(6,333)
  408.  331   Format('<P><Center><Font Size=2>NOTE: Because the colors')
  409.  332   Format(' above are shown as BACKGROUNDS, <BR>they will')
  410.  333   Format('  not show up when this page is printed.</Font><P>') 
  411.  
  412.  335   Continue
  413.  
  414.        Write(6,337)
  415.        Write(6,338)
  416.        Write(6,339)
  417.        Write(6,338)
  418.        Write(6,340)  
  419.  337   Format('This document may be accessed at <A HREF=')
  420.  338   Format('http://www.fcc.gov/mmb/asd/bickel/colorit.html')
  421.  339   Format('>') 
  422.  340   Format('</A><P></Center>')
  423.  
  424.  
  425. c    Now that all of the colors have been shown, set up end-of-page
  426. c    links & gifs
  427.  
  428.        Write(6,400)
  429.        Write(6,401)
  430.        Write(6,402)
  431.        Write(6,403)
  432.        Write(6,404)
  433.  
  434.        Write(6,400)
  435.        Write(6,405)
  436.        Write(6,406)
  437.        Write(6,407)
  438.        Write(6,408)
  439.  
  440.        Write(6,406)
  441.        Write(6,409)
  442.        Write(6,410)
  443.        Write(6,406)
  444.        Write(6,411)
  445.        Write(6,412)
  446.        Write(6,406)
  447.        Write(6,413)
  448.        Write(6,414)
  449.        Write(6,406)
  450.        Write(6,415)
  451.        Write(6,416)      
  452.        Write(6,406)
  453.        Write(6,417)
  454.        Write(6,418)
  455.        Write(6,406)
  456.        Write(6,419)
  457.        Write(6,420)
  458.        Write(6,406)
  459.        Write(6,421)
  460.  
  461.        Write(6,422)
  462.        Write(6,406)
  463.        Write(6,423)
  464.        Write(6,424)
  465.        Write(6,406)
  466.        Write(6,425)
  467.        Write(6,426)
  468.        Write(6,406)
  469.        Write(6,427)
  470.        Write(6,428)
  471.        Write(6,400)
  472.  
  473.  400   Format('<CENTER>')
  474.  401   Format('<IMG SRC=' 'http://www.fcc.gov/mmb/gif/yl_bar.gif')
  475.  402   Format(' alt=' ' Line Across Page ' '>')
  476.  403   Format('</Center>')
  477.  404   Format('<P>')
  478.  405   Format('<B>Jump to:</B><BR>')
  479.  406   Format('<A HREF=')
  480.  407   Format('http://www.fcc.gov/mmb/asd/' '>')
  481.  408   Format('ASD Subject Index</A>,')
  482.  409   Format('http://www.fcc.gov/mmb/asd/welcomeALT.html' '>')
  483.  410   Format('ASD Alphabetical Index</A>,')
  484.  411   Format('http://www.fcc.gov/search/' '>')
  485.  412   Format('FCC Search Engine</A></CENTER><BR><UL><LI>')
  486.  
  487.  413   Format('http://www.fcc.gov/mmb/asd/main/filing.html' '>')
  488.  414   Format('Filing an Application</A><LI>')
  489.  415   Format('http://www.fcc.gov/mmb/asd/main/information.html')
  490.  416   Format('>Application Information</A><LI>')
  491.  417   Format('http://www.fcc.gov/mmb/asd/main/am.html' '>')
  492.  418   Format('AM</A><LI>')
  493.  419   Format('http://www.fcc.gov/mmb/asd/main/fm.html' '>')
  494.  420   Format('FM and FM Translators & Boosters</A><LI>')
  495.  421   Format('http://www.fcc.gov/mmb/asd/main/fact.html' '>')
  496.  422   Format('Fact Sheets</A><LI>')
  497.  423   Format('http://www.fcc.gov/mmb/asd/decdoc/intro.html')
  498.  424   Format('>Decisions</A><LI>')
  499.  425   Format('http://www.fcc.gov/mmb/asd/main/other.html#WITHIN')
  500.  426   Format('>Links Within FCC</A><LI>')
  501.  427   Format('http://www.fcc.gov/mmb/asd/main/other.html#OUTSIDE')
  502.  428   Format('>Links to Outside the FCC</A></UL><P>')
  503.  
  504.        Write(6,406)
  505.        Write(6,429)
  506.        Write(6,430)
  507.        Write(6,431)
  508.        Write(6,432)
  509.        Write(6,433)
  510.        Write(6,434)
  511.      
  512.  429   Format('http://www.fcc.gov/mmb/' '>Mass Media Bureau</A>')
  513.  430   Format(' -- <A HREF=' 'http://www.fcc.gov/' '>Federal ')
  514.  431   Format('  Communications Commission</A></CENTER><P>')
  515.  432   Format('<BR><BR><CENTER><IMG SRC=')
  516.  433   Format('http://www.fcc.gov/fcc-gifs/small_seal.gif')
  517.  434   Format(' alt=' '[ FCC Seal ]' '></CENTER>')
  518.  
  519.  
  520. c    ********************************************
  521. c    Without a closing HTML statement, you may not see ANY output!
  522.      
  523.        Write(6,999)
  524.  999   Format('</Body></HTML>')
  525.        Call Exit
  526.  
  527. c    END OF PROGRAM   
  528.        END
  529.